{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  WumpusExpr.Assoc
-- Copyright   :  (c) Stephen Tetley 2012
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- /Linearize/ nested lets to make them like Scheme\'s @let*@.
--
--------------------------------------------------------------------------------

module WumpusExpr.Assoc
  (
    
    assoc

  ) where


import WumpusExpr.FreshMon
import WumpusExpr.KNormal

import Control.Applicative


--------------------------------------------------------------------------------
-- nested let linearization


assoc :: Program -> Mon Program
assoc (Program main_proc defs) = 
    Program <$> assocF main_proc <*> mapM assocF defs

assocF :: Fundef -> Mon Fundef
assocF (Fundef hd args body) = Fundef hd args <$> ll body

ll :: Expr -> Mon Expr
ll (Let v e1 e2)                = ll e1 >>= insert
  where
    insert (Let vy e3 e4) = Let vy e3 <$> insert e4
    insert e              = Let v e   <$> ll e2


ll (Ifte v1 e1 e2)              = Ifte v1 <$> ll e1 <*> ll e2 
ll (e1 :>> e2)                  = (:>>) <$> ll e1 <*> ll e2
ll (Return e)                   = Return <$> ll e
ll e                            = return e
